perm filename DEPTH.JJM[1,JRA] blob
sn#027876 filedate 1973-03-06 generic text, type T, neo UTF8
00100
00200
00300 (DEFPROP DEP
00400 (LAMBDA(L)
00500 (PROG (C1 C2)
00600 (SETQ C1 (CDR C))
00700 A (SETQ C2 (COND ((NEG (CAR C1)) (CDDAR C1)) (T (CDAR C1))))
00800 (COND ((DEP1 C2 (COPY L)) (RETURN T)))
00900 (SETQ C1 (CDR C1))
01000 (COND (C1 (GO A)))
01100 (RETURN NIL)))
01200 FEXPR)
01300
01400 (DEFPROP DEP1
01500 (LAMBDA(C L1)
01600 (PROG (L Z)
01700 A(SETQ L (COPY L1)) (COND ((VAR (CAR C)) (GO B)))
01800 (SETQ Z (ASSOC (CAAR C) L))
01900 (COND ((NULL Z) NIL) ((EQ (CDR Z) 1) (RETURN T)) (T (RPLACD Z (SUB1 (CDR Z)))))
02000 (COND ((NULL (CDAR C)) NIL) ((DEP1 (CDAR C) L) (RETURN T)))
02100 B (SETQ C (CDR C))
02200 (COND (C (GO A)))
02300 (RETURN NIL)))
02400 EXPR)